home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / 68040 / boot / topvars.pl < prev    next >
Encoding:
Text File  |  1995-08-16  |  2.7 KB  |  119 lines
  1. /*  $Id: topvars.pl,v 1.4 1995/08/16 11:49:26 jan Exp $
  2.  
  3.     Part of XPCE
  4.     Designed and implemented by Anjo Anjewierden and Jan Wielemaker
  5.     E-mail: jan@swi.psy.uva.nl
  6.  
  7.     Copyright (C) 1994 University of Amsterdam. All rights reserved.
  8. */
  9.  
  10. :- module(toplevel_variables,
  11.       [ print_toplevel_variables/0
  12.       , verbose_expansion/1
  13.       ]).
  14.  
  15. :- dynamic
  16.     verbose/0.
  17.  
  18. :- initialization op(1, fx, $).
  19.  
  20. expand_query(Query, Expanded, Bindings, ExpandedBindings) :-
  21.     expand_vars(Bindings, Query, Expanded),
  22.     free_variables(Expanded, Free),
  23.     delete_bound_vars(Bindings, Free, ExpandedBindings),
  24.     (   verbose,
  25.         Query \=@= Expanded
  26.     ->  print_query(Expanded, ExpandedBindings)
  27.     ;   true
  28.     ).
  29.  
  30.  
  31. print_query(Query, Bindings) :-
  32.     checklist(call, Bindings),
  33.     writeq(Query), write('.'), nl,
  34.     fail.
  35. print_query(_, _).
  36.  
  37.  
  38. expand_vars(_, Var, Var) :-
  39.     var(Var), !.
  40. expand_vars(_, Atomic, Atomic) :-
  41.     atomic(Atomic), !.
  42. expand_vars(Bindings, $(Var), Value) :-
  43.     name_var(Var, Bindings, Name),
  44.     (   toplevel_var(Name, Value)
  45.     ->  !
  46.     ;   $warning('$~w: No such variable', Name)
  47.     ).
  48. expand_vars(Bindings, Term, Expanded) :-
  49.     functor(Term, Name, Arity), !,
  50.     functor(Expanded, Name, Arity),
  51.     End is Arity + 1,
  52.     expand_args(1, End, Bindings, Term, Expanded).
  53.  
  54. expand_args(End, End, _, _, _) :- !.
  55. expand_args(Arg0, End, Bindings, T0, T) :-
  56.     arg(Arg0, T0, V0),
  57.     expand_vars(Bindings, V0, V1),
  58.     arg(Arg0, T, V1),
  59.     Arg1 is Arg0 + 1,
  60.     expand_args(Arg1, End, Bindings, T0, T).
  61.  
  62. name_var(Var, [VarName = TheVar|_], VarName) :-
  63.     Var == TheVar, !.
  64. name_var(Var, [_|T], Name) :-
  65.     name_var(Var, T, Name).
  66.  
  67.  
  68. delete_bound_vars([], _, []).
  69. delete_bound_vars([H|T0], Free, [H|T1]) :-
  70.     H = (_Name = Value),
  71.     v_member(Value, Free), !,
  72.     delete_bound_vars(T0, Free, T1).
  73. delete_bound_vars([_|T0], Free, T1) :-
  74.     delete_bound_vars(T0, Free, T1).
  75.  
  76. v_member(V, [H|T]) :-
  77.     (   V == H
  78.     ;   v_member(V, T)
  79.     ).
  80.  
  81. expand_answer(Bindings, Bindings) :-
  82.     assert_bindings(Bindings).
  83.  
  84. assert_bindings([]).
  85. assert_bindings([Binding|Tail]) :-
  86.     Binding = (Var = _),
  87.     forall(recorded('$topvar', Var = _, Ref), erase(Ref)),
  88.     recorda('$topvar', Binding, _),
  89.     assert_bindings(Tail).
  90.       
  91. toplevel_var(Var, Binding) :-
  92.     recorded('$topvar', Var=Binding).
  93.  
  94. print_toplevel_variables :-
  95.     toplevel_var(Name, Value),
  96.     format('$~w =~t~12|~p~n', [Name, Value]),
  97.     fail.
  98. print_toplevel_variables :-
  99.     toplevel_var(_, _), !.
  100. print_toplevel_variables :-
  101.     format('No defined toplevel variables~n').
  102.  
  103.  
  104. verbose_expansion(on) :- !,
  105.     retractall(verbose),
  106.     asserta(verbose).
  107. verbose_expansion(off) :-
  108.     retractall(verbose).
  109.  
  110. :- multifile
  111.     user:expand_query/4,
  112.     user:expand_answer/2.
  113.  
  114. user:expand_query(A, B, C, D) :-
  115.     toplevel_variables:expand_query(A, B, C, D).
  116. user:expand_answer(A, B) :-
  117.     toplevel_variables:expand_answer(A, B).
  118.  
  119.